CD ROM Paradise Collection 4/CD ROM Paradise Collection 4 1995 Nov.iso/comms/b_link10.zip/B-LINK.EXE/B-LINK/B-LINK.BAS

BASIC Source File | 1994-02-06 | 56KB | 1,989 lines

'
'
'
'
'
'
' B-LINK - BASIC Link to the NEWTON
' FREEWARE by John Marman (Compuserve: 70410,1257)
'
'
'
' This program may be freely distributed provided it is not altered and
' no fees may be charged for it's distribution.
'
'
'
'
'
'
'
'Sub and function declarations
DECLARE SUB showdump (dinp$, dLEN%)
DECLARE SUB Summary ()
DECLARE SUB LCenter (text$)
DECLARE SUB Initialize ()
DECLARE SUB Intro ()
DECLARE SUB SparklePause ()
DECLARE SUB center (row%, text$)
DECLARE SUB FancyCls (dots%, Background%)
DECLARE SUB MenuSystem ()
DECLARE SUB Box (Row1%, Col1%, Row2%, Col2%)
DECLARE SUB PrintHelpLine (Help$)
DECLARE SUB DataEntry ()
DECLARE SUB Summary ()
DECLARE SUB InitSF ()
DECLARE SUB ShowMessage (message$)
DECLARE SUB ClearMessage ()
DECLARE SUB LoadRecords ()
DECLARE SUB SaveRecords ()
DECLARE SUB ClearFields ()
DECLARE SUB KbdEdit (buffer$, maxlen%, fg%, bg%, cancel%, edit$)
DECLARE SUB AddRecord ()
DECLARE SUB DeleteRecord ()
DECLARE SUB EditRecord ()
DECLARE SUB SortRecords ()
DECLARE SUB FindRecord ()
DECLARE SUB PrevRecord ()
DECLARE SUB NextRecord ()
DECLARE SUB PrintRecords ()
DECLARE SUB ErrBeep ()
DECLARE SUB Help ()
DECLARE SUB ShowRecord ()
DECLARE SUB PaintDisplay ()
DECLARE SUB Frame (top%, bottom%, left%, right%)

DECLARE FUNCTION CompareRecords% (index1%, index2%)
DECLARE FUNCTION GetYesNo% (prompt$)
DECLARE FUNCTION GetKey$ ()
DECLARE FUNCTION ComposeChkSum$ (chksum%)
DECLARE FUNCTION checksum% (inbuff$)
DECLARE FUNCTION XmitNewton% ()
DECLARE FUNCTION GetString$ (row%, col%, start$, end$, Vis%, Max%)
DECLARE FUNCTION Trim$ (x$)
DECLARE FUNCTION CheckEdit% (temp$, edit$)
DECLARE FUNCTION Menu% (CurrChoiceX%, MaxChoice%, choice$(), ItemRow%(), ItemCol%(), menuHelp$(), BarMode%)

DEFINT A-Z

'Constants
CONST TRUE = -1
CONST FALSE = NOT TRUE

CONST NNAMES = 1
CONST NSCHED = 2
CONST NANN = 3
CONST NDAILY = 4
CONST NALARM = 5
CONST NNOTE = 6

'Makes arrays dynamic
'$DYNAMIC

CONST WINTOP = 5, WINBOTTOM = 19
CONST WINLEFT = 10, WINRIGHT = 70

CONST MESSAGEROW = 22

TYPE CRrecord
        CRType AS INTEGER
        CRData AS STRING * 255
END TYPE

TYPE SFField
        SFScreen AS INTEGER
        SFName AS STRING * 25
        SFMax AS INTEGER
        SFRow AS INTEGER
        SFCol AS INTEGER
        SFData AS STRING * 255
        SFedit AS STRING * 1
        SFPos AS INTEGER
        SFSuff AS INTEGER
END TYPE

TYPE ScreenD
        fieldptr AS INTEGER
        fname AS STRING * 40
END TYPE

TYPE Sharp
        Sname AS STRING * 13
        Sapp  AS STRING * 11
        Snum  AS STRING * 4
        Schksum AS DOUBLE
        Sfields AS INTEGER
END TYPE

COMMON SHARED scrnFg
COMMON SHARED scrnBg
COMMON SHARED winFg
COMMON SHARED winBg
COMMON SHARED statFg
COMMON SHARED statBg

COMMON SHARED NumRecords
COMMON SHARED CurrRecord

COMMON SHARED EditState$

COMMON SHARED SFScreenNum

COMMON SHARED CRLF$
COMMON SHARED ETX$
COMMON SHARED SUB$
COMMON SHARED HT$

COMMON SHARED COMM$

'Global variables
DIM SHARED ColorPref                            'Color Preference
DIM SHARED colors(0 TO 20, 1 TO 4)              'Different Colors
DIM SHARED PrintErr AS INTEGER                  'Printer error flag
DIM SHARED CRrecords(0) AS CRrecord
DIM SHARED fields(30) AS SFField
DIM SHARED ScreenData(6) AS ScreenD
DIM SHARED SharpRec(6) AS Sharp

    DEF SEG = 0                     ' Turn off CapLock, NumLock and ScrollLock
    KeyFlags = PEEK(1047)
    POKE 1047, &H0
    DEF SEG

   NumRecords = 0
   CurrRecord = 0

    scrnFg = 11
    scrnBg = 1
    winFg = 0
    winBg = 7
    statFg = 0
    statBg = 3

    Initialize          'Initialize program
    CALL InitSF         'Init fields
    Intro               'Display introduction screen
    MenuSystem          'This is the main program
    COLOR 7, 0          'Clear screen and end
    CLS

    DEF SEG = 0                     ' Restore CapLock, NumLock and ScrollLock states
    POKE 1047, KeyFlags
    DEF SEG

    SYSTEM
    END


'The following data defines the color schemes available via the main menu.
'                            0 0 14 14
'    scrn  dots  bar  back   title  shdow  choice  curs   cursbk  shdow
DATA 0,    7,    15,  7,     0,     7,     0,      15,    0,      0
DATA 1,    9,    12,  3,     0,     1,     15,     0,     7,      0
DATA 3,    15,   13,  1,     0,     3,     15,     0,     7,      0
DATA 7,    12,   15,  4,     0,     0,     15,     15,    1,      0

REM $STATIC
' B-LINK - BASIC Link to the NEWTON
' FREEWARE by John Marman (Compuserve: 70410,1257)
'
' This program may be freely distributed provided it is not altered and
' no fees may be charged for it's distribution.
'
'
' Adds a new record to the database and makes it the current record
'
SUB AddRecord

   DIM newentry AS CRrecord        'Temporary record

   COLOR winFg, winBg
   CALL ClearFields              'Clear current record from window

        i = ScreenData(SFScreenNum).fieldptr
        recpos = 1
        DO WHILE fields(i).SFScreen = SFScreenNum
                LOCATE fields(i).SFRow, fields(i).SFCol
                tempfield$ = SPACE$(fields(i).SFMax)
                CALL KbdEdit(tempfield$, fields(i).SFMax, winFg, winBg, cancel, fields(i).SFedit)
                IF cancel THEN GOTO cancelEntry
                ' put the update into newentry's data field
                MID$(newentry.CRData, recpos, fields(i).SFMax) = LEFT$(tempfield$, fields(i).SFMax)
                recpos = recpos + fields(i).SFMax
                i = i + 1
                LOOP

   'Allocate temporary storage for records
   REDIM temp(NumRecords) AS CRrecord
   FOR i = 1 TO NumRecords
      temp(i) = CRrecords(i)
   NEXT i

   'Resize records array and restore records
   REDIM CRrecords(NumRecords + 1) AS CRrecord
   FOR i = 1 TO NumRecords
      CRrecords(i) = temp(i)
   NEXT i
   ERASE temp

   NumRecords = NumRecords + 1
   CurrRecord = NumRecords

   newentry.CRType = SFScreenNum
   CRrecords(CurrRecord) = newentry

cancelEntry:
   CALL ShowRecord               'Update display

END SUB

REM $DYNAMIC
'Box:
'  Draw a box on the screen between the given coordinates.
SUB Box (Row1, Col1, Row2, Col2) STATIC

    BoxWidth = Col2 - Col1 + 1

    LOCATE Row1, Col1
    PRINT "┌"; STRING$(BoxWidth - 2, "─"); "┐";

    FOR a = Row1 + 1 TO Row2 - 1
        LOCATE a, Col1
        PRINT "│"; SPACE$(BoxWidth - 2); "│";
    NEXT a

    LOCATE Row2, Col1
    PRINT "└"; STRING$(BoxWidth - 2, "─"); "┘";

END SUB

'Center:
'  Center text on the given row.
SUB center (row, text$)
    LOCATE row, 41 - LEN(text$) / 2
    PRINT text$;
END SUB

REM $STATIC
FUNCTION CheckEdit (temp$, edit$)
        ret = 1
        SELECT CASE edit$
        CASE "Y"
                IF VAL(temp$) < 1904 OR VAL(temp$) > 2999 THEN ret = 0
        CASE "M"
                IF LEN(temp$) < 4 THEN ret = 0
                mm = VAL(LEFT$(temp$, 2)): dd = VAL(RIGHT$(temp$, 2))
                IF mm < 1 OR mm > 12 OR dd < 1 OR dd > 31 THEN ret = 0
        CASE "T"
                IF LEN(temp$) < 4 THEN ret = 0
                hh = VAL(LEFT$(temp$, 2)): mm = VAL(RIGHT$(temp$, 2))
                IF hh > 23 OR mm > 59 THEN ret = 0
        CASE " "
                IF LEN(temp$) < 2 THEN ret = 0
        END SELECT
        CheckEdit = ret
END FUNCTION

FUNCTION checksum% (inbuff$)
        chksum = 0
        FOR i = 1 TO LEN(inbuff$)
                chksum = chksum + ASC(MID$(inbuff$, i, 1))
                NEXT i
        checksum = chksum
END FUNCTION

'
' Clears all record fields using the current color
'
SUB ClearFields

        i = ScreenData(SFScreenNum).fieldptr
        DO WHILE fields(i).SFScreen = SFScreenNum
                LOCATE fields(i).SFRow, fields(i).SFCol
                PRINT SPACE$(fields(i).SFMax)
                i = i + 1
                LOOP

END SUB

'
' Clears the current message from the message area
'
SUB ClearMessage

   COLOR scrnFg, scrnBg
   LOCATE MESSAGEROW, 1
   PRINT SPACE$(80)

END SUB

'
' Compares two records. Returns 1 if the first record should
' come after the second. Otherwise 0 is returned.
'
FUNCTION CompareRecords (index1, index2)

   CompareRecords = 0

   IF CRrecords(index1).CRType > CRrecords(index2).CRType THEN
      CompareRecords = 1
   ELSEIF CRrecords(index1).CRType = CRrecords(index2).CRType THEN
      IF CRrecords(index1).CRType > CRrecords(index2).CRType THEN
         CompareRecords = 1
      END IF
   END IF

END FUNCTION

FUNCTION ComposeChkSum$ (chksum)
        i = chksum AND &HFF
        j = INT(chksum / 256) AND &HFF
        chksum$ = RIGHT$(HEX$(i + 512), 2) + RIGHT$(HEX$(j + 512), 2)
        ComposeChkSum$ = chksum$
END FUNCTION

' B-LINK - BASIC Link to the NEWTON
' FREEWARE by John Marman (Compuserve: 70410,1257)
'
' This program may be freely distributed provided it is not altered and
' no fees may be charged for it's distribution.
'
'
SUB DataEntry

   CALL PaintDisplay

   FOR i = 1 TO NumRecords
        IF CRrecords(i).CRType = SFScreenNum THEN CurrRecord = i: GOTO foundrec
        NEXT i
   CALL AddRecord

foundrec:
   CALL ShowRecord

   DO
      EditState$ = " "
      SELECT CASE GetKey$
         CASE CHR$(&H0) + CHR$(&H3B)   'F1 (Help)
            CALL Help
         CASE CHR$(&H0) + CHR$(&H3C)   'F2 (Add)
            CALL AddRecord
         CASE CHR$(&H0) + CHR$(&H3D)   'F3 (Delete)
           IF NumRecords > 0 THEN
                IF GetYesNo("Delete the current record [Y/N]?") THEN CALL DeleteRecord
           ELSE
                CALL ErrBeep
           END IF
         CASE CHR$(&H0) + CHR$(&H3E)   'F4 (Edit)
            EditState$ = "E"
            CALL EditRecord
         CASE CHR$(&H0) + CHR$(&H3F)   'F5 (Find)
            CALL FindRecord
         CASE CHR$(&H0) + CHR$(&H40)   'F6 (Previous)
            CALL PrevRecord
         CASE CHR$(&H0) + CHR$(&H41)   'F7 (Next)
            CALL NextRecord
         CASE CHR$(&H0) + CHR$(&H42)   'F8 (Send)
            IF XmitNewton = -1 THEN EXIT DO
         CASE CHR$(&H0) + CHR$(&H43)   'F9 (Print)
            CALL PrintRecords
         CASE CHR$(&H0) + CHR$(&H44)   'F10 (Exit)
            EXIT DO
         CASE ELSE
            CALL ErrBeep
      END SELECT
   LOOP

   COLOR 7, 0, 0
   CLS

END SUB

'
' Deletes the current record
'
SUB DeleteRecord

         'Allocate temporary storage for records
         REDIM temp(NumRecords - 1) AS CRrecord

         'Fill temporary array with all records except
         'the current record
         FOR i = 1 TO (CurrRecord - 1)
            temp(i) = CRrecords(i)
         NEXT i
         FOR i = CurrRecord TO (NumRecords - 1)
            temp(i) = CRrecords(i + 1)
         NEXT i

         'One less record
         NumRecords = NumRecords - 1

         'Resize records array and restore records
         REDIM CRrecords(NumRecords) AS CRrecord
         FOR i = 1 TO NumRecords
            CRrecords(i) = temp(i)
         NEXT i
         ERASE temp

         'Make sure currRecord remains within range
         IF CurrRecord > NumRecords THEN CurrRecord = NumRecords

         CALL ShowRecord      'Update display

END SUB

' B-LINK - BASIC Link to the NEWTON
' FREEWARE by John Marman (Compuserve: 70410,1257)
'
' This program may be freely distributed provided it is not altered and
' no fees may be charged for it's distribution.
'
'
' Allows the user to edit the current record
'
SUB EditRecord

   DIM newentry AS CRrecord        'Temporary record

   IF CurrRecord = 0 THEN        'Nothing to edit
      CALL ErrBeep
      EXIT SUB
   END IF

   CALL ShowMessage("Edit the current field  <Enter>=Next field  <Esc>=Cancel")

   newentry = CRrecords(CurrRecord)

   COLOR statFg, statBg          'Edit record a field at a time

        i = ScreenData(SFScreenNum).fieldptr
        recpos = 1
        DO WHILE fields(i).SFScreen = SFScreenNum
                LOCATE fields(i).SFRow, fields(i).SFCol
                tempfield$ = fields(i).SFData
                CALL KbdEdit(tempfield$, fields(i).SFMax, winFg, winBg, cancel, fields(i).SFedit)
                IF cancel THEN GOTO cancelEdit
                ' put the update into newentry's data field
                MID$(newentry.CRData, recpos, fields(i).SFMax) = LEFT$(tempfield$, fields(i).SFMax)
                recpos = recpos + fields(i).SFMax
                i = i + 1
                LOOP

        CRrecords(CurrRecord) = newentry

cancelEdit:
   CALL ShowRecord               'Update display
   CALL ClearMessage

END SUB

'
' Sounds the computers internal speaker
'
SUB ErrBeep

   SOUND 800, 2
   SOUND 400, 2

   WHILE INKEY$ <> "": WEND         'Flush keyboard buffer

END SUB

REM $DYNAMIC
'  Clears screen in the right color, and draws nice dots.
SUB FancyCls (dots, Background)

    VIEW PRINT 2 TO 24
    COLOR dots, Background
    CLS 2
    VIEW PRINT

END SUB

REM $STATIC
'
' Searches the database for a given string (not case sensitive)
'
SUB FindRecord

   'Get input and convert to upper case
   LOCATE MESSAGEROW, 15
   COLOR scrnFg, scrnBg
   PRINT "Enter search string: ";
   CALL KbdEdit(inputString$, 30, scrnFg, scrnBg, cancel, " ")
   CALL ClearMessage

   IF cancel = 1 THEN EXIT SUB
   searchString$ = UCASE$(inputString$)

   'Scan records for match
   FOR i = 1 TO NumRecords
      found = 0
      IF INSTR(UCASE$(CRrecords(i).CRData), searchString$) <> 0 THEN
         SFScreenNum = CRrecords(i).CRType
         found = 1
      END IF

      'If a match was found, show matching record and
      'ask if the search should continue
      IF found = 1 THEN
         CurrRecord = i
         CALL PaintDisplay
         CALL ShowRecord
         IF GetYesNo("Find next match [Y/N]?") = 0 THEN EXIT SUB
      END IF
   NEXT i

   'Tell user no more matches found
   a$ = "Match not found for " + CHR$(&H22) + inputString$
   a$ = a$ + CHR$(&H22) + ", press any key"
   CALL ShowMessage(a$)
   a$ = GetKey$
   CALL ClearMessage

END SUB

'
' Displays a box with the specified coordinates
' The inside of the box is cleared to the current color
'
SUB Frame (top, bottom, left, right)

   LOCATE top, left
   PRINT CHR$(&HC9); STRING$((right - left) - 1, CHR$(&HCD)); CHR$(&HBB);

   FOR row = (top + 1) TO (bottom - 1)
      LOCATE row, left
      PRINT CHR$(&HBA); SPACE$((right - left) - 1); CHR$(&HBA);
   NEXT row

   LOCATE bottom, left
   PRINT CHR$(&HC8); STRING$((right - left) - 1, CHR$(&HCD)); CHR$(&HBC);

END SUB

'
' Returns the next available keystroke (read with INKEY$)
'
FUNCTION GetKey$

   ch$ = "": WHILE ch$ = "": ch$ = INKEY$: WEND
   GetKey$ = ch$

END FUNCTION

REM $DYNAMIC
'GetString$:
'  Given a row and col, and an initial string, edit a string
'  VIS is the length of the visible field of entry
'  MAX is the maximum number of characters allowed in the string
FUNCTION GetString$ (row, col, start$, end$, Vis, Max)
    curr$ = Trim$(LEFT$(start$, Max))
    IF curr$ = CHR$(8) THEN curr$ = ""

    LOCATE , , 1

    finished = FALSE
    DO
        GOSUB GetStringShowText
        GOSUB GetStringGetKey

        IF LEN(Kbd$) > 1 THEN
            finished = TRUE
            GetString$ = Kbd$
        ELSE
            SELECT CASE Kbd$
                CASE CHR$(13), CHR$(27), CHR$(9)
                    finished = TRUE
                    GetString$ = Kbd$

                CASE CHR$(8)
                    IF curr$ <> "" THEN
                        curr$ = LEFT$(curr$, LEN(curr$) - 1)
                    END IF

                CASE " " TO "}"
                    IF LEN(curr$) < Max THEN
                        curr$ = curr$ + Kbd$
                    ELSE
                        BEEP
                    END IF

                CASE ELSE
                    BEEP
            END SELECT
        END IF

    LOOP UNTIL finished

    end$ = curr$
    LOCATE , , 0
    EXIT FUNCTION


GetStringShowText:
    LOCATE row, col
    IF LEN(curr$) > Vis THEN
        PRINT RIGHT$(curr$, Vis);
    ELSE
        PRINT curr$; SPACE$(Vis - LEN(curr$));
        LOCATE row, col + LEN(curr$)
    END IF
    RETURN

GetStringGetKey:
    Kbd$ = ""
    WHILE Kbd$ = ""
        Kbd$ = INKEY$
    WEND
    RETURN
END FUNCTION

REM $STATIC
'
' Displays the given prompt and gets a yes/no response from the user
' Returns 1 if "Y" was pressed or 0 if "N" was pressed
'
FUNCTION GetYesNo (prompt$)

   CALL ShowMessage(prompt$)

   DO
      a$ = UCASE$(GetKey$)             'Wait for "Y" or "N"
      IF a$ = "Y" OR a$ = "N" THEN
         EXIT DO
      ELSE
         CALL ErrBeep
      END IF
   LOOP

   CALL ClearMessage

   IF a$ = "Y" THEN GetYesNo = 1 ELSE GetYesNo = 0

END FUNCTION

'
' Displays help screen
'
SUB Help

   COLOR winFg, winBg
   CALL Frame(5, 19, 3, 78)   'Create help window

   LOCATE 7, 33               'Display help info
   PRINT "Help Screen"

   tab1 = 7
   tab2 = 44
   LOCATE 9, tab1
   PRINT "<F1>=Help (this screen)";
   LOCATE , tab2
   PRINT "<F2>=Add a new record"
   LOCATE , tab1
   PRINT "<F3>=Delete the current record";
   LOCATE , tab2
   PRINT "<F4>=Edit the current record"
   LOCATE , tab1
   PRINT "<F5>=Find records";
   LOCATE , tab2
   PRINT "<F6>=Show the previous record"
   LOCATE , tab1
   PRINT "<F7>=Show the next record";
   LOCATE , tab2
   PRINT "<F8>=Send record to the NEWTON"
   LOCATE , tab1
   PRINT "<F9>=Send records to a printer";
   LOCATE , tab2
   PRINT "<F10>=Exit Data Entry"

   LOCATE 17, 27
   PRINT "Press any key to exit help"
   a$ = GetKey$

   CALL PaintDisplay          'Restore screen

END SUB

REM $DYNAMIC
'Initialize:
' Read colors in
SUB Initialize

    WIDTH , 25
    VIEW PRINT

    FOR ColorSet = 1 TO 4
        FOR x = 1 TO 10
            READ colors(x, ColorSet)
        NEXT x
    NEXT ColorSet

END SUB

REM $STATIC
' B-LINK - BASIC Link to the NEWTON
' FREEWARE by John Marman (Compuserve: 70410,1257)
'
' This program may be freely distributed provided it is not altered and
' no fees may be charged for it's distribution.
'
SUB InitSF

        COMM$ = "COM1:"

        CRLF$ = CHR$(13) + CHR$(10)
        ETX$ = CHR$(3)
        SUB$ = CHR$(26)
        HT$ = CHR$(9)

'       this struct defines info about each sharp app
        SharpRec(NNAMES).Sname = "Business Card"
        SharpRec(NNAMES).Sapp = "BUSINESS1  "
        SharpRec(NNAMES).Snum = "1E00"
        SharpRec(NNAMES).Schksum = 1234
        SharpRec(NNAMES).Sfields = 7

        ScreenData(NNAMES).fieldptr = 1
        ScreenData(NNAMES).fname = "Names File Data Entry Screen"

'       this struct defines info about each data item
        fields(1).SFScreen = NNAMES
        fields(1).SFName = "Last Name:"
        fields(1).SFMax = 30
        fields(1).SFRow = 6
        fields(1).SFCol = 23
        fields(1).SFData = ""
        fields(1).SFedit = " "
        fields(1).SFPos = 5
        fields(1).SFSuff = 1

        fields(2).SFScreen = NNAMES
        fields(2).SFName = "Company:"
        fields(2).SFMax = 30
        fields(2).SFRow = 8
        fields(2).SFCol = 23
        fields(2).SFData = ""
        fields(2).SFedit = " "
        fields(2).SFPos = 1
        fields(2).SFSuff = 2

        fields(3).SFScreen = NNAMES
        fields(3).SFName = "Title:"
        fields(3).SFMax = 30
        fields(3).SFRow = 10
        fields(3).SFCol = 23
        fields(3).SFData = ""
        fields(3).SFedit = "D"
        fields(3).SFPos = 6
        fields(3).SFSuff = 1

        fields(4).SFScreen = NNAMES
        fields(4).SFName = "Address:"
        fields(4).SFMax = 30
        fields(4).SFRow = 12
        fields(4).SFCol = 23
        fields(4).SFData = ""
        fields(4).SFedit = "D"
        fields(4).SFPos = 4
        fields(4).SFSuff = 1

        fields(5).SFScreen = NNAMES
        fields(5).SFName = "Phone:"
        fields(5).SFMax = 20
        fields(5).SFRow = 14
        fields(5).SFCol = 23
        fields(5).SFData = ""
        fields(5).SFedit = "D"
        fields(5).SFPos = 2
        fields(5).SFSuff = 1

        fields(6).SFScreen = NNAMES
        fields(6).SFName = "Fax:"
        fields(6).SFMax = 20
        fields(6).SFRow = 16
        fields(6).SFCol = 23
        fields(6).SFData = ""
        fields(6).SFedit = "D"
        fields(6).SFPos = 3
        fields(6).SFSuff = 1

        fields(7).SFScreen = NNAMES
        fields(7).SFName = "Phone:"
        fields(7).SFMax = 20
        fields(7).SFRow = 18
        fields(7).SFCol = 23
        fields(7).SFData = ""
        fields(7).SFedit = "D"
        fields(7).SFPos = 7
        fields(7).SFSuff = 5

' schedule item

        SharpRec(NSCHED).Sname = "Schedule     "
        SharpRec(NSCHED).Sapp = "SCHEDULE1  "
        SharpRec(NSCHED).Snum = "0110"
        SharpRec(NSCHED).Schksum = 1183
        SharpRec(NSCHED).Sfields = 6

        ScreenData(NSCHED).fieldptr = 8
        ScreenData(NSCHED).fname = "Single Appointment Data Entry Screen"

        fields(8).SFScreen = NSCHED
        fields(8).SFName = "Year:"
        fields(8).SFMax = 4
        fields(8).SFRow = 7
        fields(8).SFCol = 31
        fields(8).SFData = ""
        fields(8).SFedit = "Y"
        fields(8).SFPos = 1
        fields(8).SFSuff = 0

        fields(9).SFScreen = NSCHED
        fields(9).SFName = "Start Date (MMDD):"
        fields(9).SFMax = 4
        fields(9).SFRow = 9
        fields(9).SFCol = 31
        fields(9).SFData = ""
        fields(9).SFedit = "M"
        fields(9).SFPos = 2
        fields(9).SFSuff = 0

        fields(10).SFScreen = NSCHED
        fields(10).SFName = "Start Time (HHMM):"
        fields(10).SFMax = 4
        fields(10).SFRow = 9
        fields(10).SFCol = 58
        fields(10).SFData = ""
        fields(10).SFedit = "T"
        fields(10).SFPos = 3
        fields(10).SFSuff = 0

        fields(11).SFScreen = NSCHED
        fields(11).SFName = "End Time (HHMM):"
        fields(11).SFMax = 4
        fields(11).SFRow = 10
        fields(11).SFCol = 58
        fields(11).SFData = ""
        fields(11).SFedit = "T"
        fields(11).SFPos = 4
        fields(11).SFSuff = 0

        fields(12).SFScreen = NSCHED
        fields(12).SFName = "Alarm Time (HHMM):"
        fields(12).SFMax = 4
        fields(12).SFRow = 12
        fields(12).SFCol = 58
        fields(12).SFData = ""
        fields(12).SFedit = "T"
        fields(12).SFPos = 5
        fields(12).SFSuff = 1

        fields(13).SFScreen = NSCHED
        fields(13).SFName = "Description:"
        fields(13).SFMax = 25
        fields(13).SFRow = 14
        fields(13).SFCol = 31
        fields(13).SFData = ""
        fields(13).SFedit = " "
        fields(13).SFPos = 6
        fields(13).SFSuff = 0

' anniversary

        SharpRec(NANN).Sname = "Anniversary 1"
        SharpRec(NANN).Sapp = "ANN     1  "
        SharpRec(NANN).Snum = "0110"
        SharpRec(NANN).Schksum = 975
        SharpRec(NANN).Sfields = 2

        ScreenData(NANN).fieldptr = 14
        ScreenData(NANN).fname = "Recurring Anniversary Data Entry Screen"

        fields(14).SFScreen = NANN
        fields(14).SFName = "Date (MMDD):"
        fields(14).SFMax = 4
        fields(14).SFRow = 9
        fields(14).SFCol = 31
        fields(14).SFData = ""
        fields(14).SFedit = "M"
        fields(14).SFPos = 1
        fields(14).SFSuff = 1

        fields(15).SFScreen = NANN
        fields(15).SFName = "Description:"
        fields(15).SFMax = 25
        fields(15).SFRow = 11
        fields(15).SFCol = 31
        fields(15).SFData = ""
        fields(15).SFedit = " "
        fields(15).SFPos = 2
        fields(15).SFSuff = 0

' daily note

        SharpRec(NDAILY).Sname = "Period       "
        SharpRec(NDAILY).Sapp = "PERIOD  1  "
        SharpRec(NDAILY).Snum = "0110"
        SharpRec(NDAILY).Schksum = 1109
        SharpRec(NDAILY).Sfields = 5

        ScreenData(NDAILY).fieldptr = 16
        ScreenData(NDAILY).fname = "Recurring Daily Note Data Entry Screen"

        fields(16).SFScreen = NDAILY
        fields(16).SFName = "Start Year (YYYY):"
        fields(16).SFMax = 4
        fields(16).SFRow = 7
        fields(16).SFCol = 31
        fields(16).SFData = ""
        fields(16).SFedit = "Y"
        fields(16).SFPos = 1
        fields(16).SFSuff = 0

        fields(17).SFScreen = NDAILY
        fields(17).SFName = "Start Date (MMDD):"
        fields(17).SFMax = 4
        fields(17).SFRow = 9
        fields(17).SFCol = 31
        fields(17).SFData = ""
        fields(17).SFedit = "M"
        fields(17).SFPos = 2
        fields(17).SFSuff = 0

        fields(18).SFScreen = NDAILY
        fields(18).SFName = "End Year (YYYY):"
        fields(18).SFMax = 4
        fields(18).SFRow = 7
        fields(18).SFCol = 58
        fields(18).SFData = ""
        fields(18).SFedit = "Y"
        fields(18).SFPos = 3
        fields(18).SFSuff = 0

        fields(19).SFScreen = NDAILY
        fields(19).SFName = "End Date (MMDD):"
        fields(19).SFMax = 4
        fields(19).SFRow = 9
        fields(19).SFCol = 58
        fields(19).SFData = ""
        fields(19).SFedit = "M"
        fields(19).SFPos = 4
        fields(19).SFSuff = 1

        fields(20).SFScreen = NDAILY
        fields(20).SFName = "Description:"
        fields(20).SFMax = 25
        fields(20).SFRow = 11
        fields(20).SFCol = 31
        fields(20).SFData = ""
        fields(20).SFedit = " "
        fields(20).SFPos = 5
        fields(20).SFSuff = 0

' daily alarm

        SharpRec(NALARM).Sname = "Alarm        "
        SharpRec(NALARM).Sapp = "D ALARM 1  "
        SharpRec(NALARM).Snum = "0110"
        SharpRec(NALARM).Schksum = 1091
        SharpRec(NALARM).Sfields = 1

        ScreenData(NALARM).fieldptr = 21
        ScreenData(NALARM).fname = "Recurring Daily Alarm Data Entry Screen"

        fields(21).SFScreen = NALARM
        fields(21).SFName = "Time (HHMM):"
        fields(21).SFMax = 4
        fields(21).SFRow = 11
        fields(21).SFCol = 31
        fields(21).SFData = ""
        fields(21).SFedit = "T"
        fields(21).SFPos = 1
        fields(21).SFSuff = 0

' notepad

        SharpRec(NNOTE).Sname = "Memo         "
        SharpRec(NNOTE).Sapp = "MEMO    1  "
        SharpRec(NNOTE).Snum = "0300"
        SharpRec(NNOTE).Schksum = 1025
        SharpRec(NNOTE).Sfields = 5

        ScreenData(NNOTE).fieldptr = 22
        ScreenData(NNOTE).fname = "NotePad Data Entry Screen"

        fields(22).SFScreen = NNOTE
        fields(22).SFName = "Line 1 :"
        fields(22).SFMax = 30
        fields(22).SFRow = 7
        fields(22).SFCol = 31
        fields(22).SFData = ""
        fields(22).SFedit = " "
        fields(22).SFPos = 1
        fields(22).SFSuff = 0

        fields(23).SFScreen = NNOTE
        fields(23).SFName = "Line 2 :"
        fields(23).SFMax = 30
        fields(23).SFRow = 8
        fields(23).SFCol = 31
        fields(23).SFData = ""
        fields(23).SFedit = "D"
        fields(23).SFPos = 2
        fields(23).SFSuff = 0

        fields(24).SFScreen = NNOTE
        fields(24).SFName = "Line 3 :"
        fields(24).SFMax = 30
        fields(24).SFRow = 9
        fields(24).SFCol = 31
        fields(24).SFData = ""
        fields(24).SFedit = "D"
        fields(24).SFPos = 3
        fields(24).SFSuff = 0

        fields(25).SFScreen = NNOTE
        fields(25).SFName = "Line 4 :"
        fields(25).SFMax = 30
        fields(25).SFRow = 10
        fields(25).SFCol = 31
        fields(25).SFData = ""
        fields(25).SFedit = "D"
        fields(25).SFPos = 4
        fields(25).SFSuff = 0

        fields(26).SFScreen = NNOTE
        fields(26).SFName = "Line 5 :"
        fields(26).SFMax = 30
        fields(26).SFRow = 11
        fields(26).SFCol = 31
        fields(26).SFData = ""
        fields(26).SFedit = "D"
        fields(26).SFPos = 5
        fields(26).SFSuff = 0


        fields(27).SFScreen = 99 'end of fields marker


END SUB

REM $DYNAMIC
'Intro:
'  Display introduction screen.
SUB Intro
    SCREEN 0
    WIDTH 80, 25
    COLOR 7, 0
    CLS
    COLOR 3
    center 8, "B - L I N K  V1.0"
    COLOR 15
    center 12, "N E W T O N  <-> P C  BASIC LINKUP"
    COLOR 7
    center 24, "(c) 1994 by John Marman - All Rights Reserved"
    COLOR 4
    center 20, "Press any key if you have backed up your NEWTON..."

    SparklePause
END SUB

REM $STATIC
' B-LINK - BASIC Link to the NEWTON
' FREEWARE by John Marman (Compuserve: 70410,1257)
'
' This program may be freely distributed provided it is not altered and
' no fees may be charged for it's distribution.
'
'
'  Keyboard editor, recognizes Escape,
'  If first key pressed is an edit key the old string is edited
'  otherwise, the old string is discarded
'
SUB KbdEdit (buffer$, maxlen, fg, bg, cancel, edit$)

   row = CSRLIN               'Save cursor position
   col = POS(0)

   'Remove trailing spaces or uninitialized 0's
   IF LEFT$(buffer$, 1) = CHR$(0) THEN buffer$ = ""
   buffer$ = RTRIM$(buffer$)
   k = INSTR(buffer$, CHR$(0))
   IF k > 0 THEN buffer$ = LEFT$(buffer$, k - 1) ELSE buffer$ = LEFT$(buffer$, maxlen)

   LOCATE row, col, 1         'Display string in inverse video
   COLOR fg, bg
   PRINT STRING$(maxlen, CHR$(&HF9));
   LOCATE row, col
   COLOR bg, fg
   PRINT buffer$;
   LOCATE row, col
   COLOR fg, bg

   a$ = GetKey$               'Get a key

   'If the key was a edit key, we will edit the original string
   'otherwise, we assume the user's typing a new string and the
   'original is discarded
   IF a$ >= " " AND a$ <= "~" THEN
      temp$ = ""
   ELSE
      temp$ = buffer$
   END IF
   posn = LEN(temp$)

   done = 0                   '0 until <Esc> or <Enter> is pressed
   first = 1                  'Indicates first time through

   DO
      'Don't read a new key if it's our first time through
      IF first = 1 THEN
         first = 0
      ELSE
         LOCATE row, col
         PRINT temp$; STRING$(maxlen - LEN(temp$), CHR$(&HF9))
         LOCATE row, col + posn
         a$ = GetKey$
      END IF
      SELECT CASE a$
         CASE "0" TO "9"
            IF LEN(temp$) < maxlen THEN
               first$ = LEFT$(temp$, posn)
               last$ = RIGHT$(temp$, LEN(temp$) - posn)
               temp$ = first$ + a$ + last$
               posn = posn + 1
            ELSE
               CALL ErrBeep
            END IF
         CASE " " TO "~"
            IF (edit$ = " " OR edit$ = "D") AND LEN(temp$) < maxlen THEN
               first$ = LEFT$(temp$, posn)
               last$ = RIGHT$(temp$, LEN(temp$) - posn)
               temp$ = first$ + a$ + last$
               posn = posn + 1
            ELSE
               CALL ErrBeep
            END IF
         CASE CHR$(8)               'Backspace
            IF posn > 0 THEN
               first$ = LEFT$(temp$, posn - 1)
               last$ = RIGHT$(temp$, LEN(temp$) - posn)
               temp$ = first$ + last$
               posn = posn - 1
            ELSE
               CALL ErrBeep
            END IF
         CASE CHR$(0) + CHR$(&H53)  'Delete
            IF posn < LEN(temp$) THEN
               first$ = LEFT$(temp$, posn)
               last$ = RIGHT$(temp$, LEN(temp$) - (posn + 1))
               temp$ = first$ + last$
            ELSE
               CALL ErrBeep
            END IF
         CASE CHR$(0) + CHR$(&H4B)  'Left
            IF posn > 0 THEN
               posn = posn - 1
            ELSE
               CALL ErrBeep
            END IF
         CASE CHR$(0) + CHR$(&H4D)  'Right
            IF posn < LEN(temp$) THEN
               posn = posn + 1
            ELSE
               CALL ErrBeep
            END IF
         CASE CHR$(0) + CHR$(&H47)  'Home
            posn = 0
         CASE CHR$(0) + CHR$(&H4F)  'End
            posn = LEN(temp$)
         CASE CHR$(13)              'Enter (Accept)
            IF CheckEdit(temp$, edit$) = 1 THEN
              buffer$ = temp$
              done = 1
              cancel = 0
            ELSE CALL ErrBeep
            END IF
         CASE CHR$(27)              'Escape (Cancel)
            done = 1
            cancel = 1
         CASE CHR$(&H0) + CHR$(&H44)   'F10 (Exit)
            done = 1
            cancel = 1
         CASE ELSE
            CALL ErrBeep
      END SELECT

   LOOP UNTIL done

   COLOR fg, bg                     'Display the resulting string
   LOCATE row, col, 0
   PRINT buffer$; SPACE$(maxlen - LEN(buffer$))

END SUB

REM $DYNAMIC
'LCenter:
'  Center TEXT$ on the line printer
SUB LCenter (text$)
    LPRINT TAB(41 - LEN(text$) / 2); text$
END SUB

REM $STATIC
'
' Loads a database from disk
'
SUB LoadRecords

   IF NumRecords > 0 THEN
     IF GetYesNo("Erase existing records in memory [Y/N]?") = 0 THEN EXIT SUB
     END IF

   CALL ShowMessage("Loading records...")

   'Open data file
   OPEN "B-LINK.DAT" FOR RANDOM AS #1 LEN = LEN(CRrecords(0))

   'Calculate numRecords and allocate records array
   NumRecords = LOF(1) \ LEN(CRrecords(0))
   REDIM CRrecords(NumRecords) AS CRrecord

   'Read records
   FOR i = 1 TO NumRecords
      GET #1, i, CRrecords(i)
   NEXT i
   CLOSE #1

   IF NumRecords > 0 THEN CurrRecord = 1
   CALL ClearMessage

    Box 9, 19, 14, 61
    center 11, "B-LINK File Import:"
    center 12, "Number of records read in:" + STR$(NumRecords)

    SLEEP 0

END SUB

REM $DYNAMIC
'Menu:
'  Handles Menu Selection for a single menu (either sub menu, or menu bar)
'  currChoiceX  :  Number of current choice
'  maxChoice    :  Number of choices in the list
'  choice$()    :  Array with the text of the choices
'  itemRow()    :  Array with the row of the choices
'  itemCol()    :  Array with the col of the choices
'  menuhelp$()      :  Array with the help text for each choice
'  barMode      :  Boolean:  TRUE = menu bar style, FALSE = drop down style
'
'  Returns the number of the choice that was made by changing currChoiceX
'  and returns the scan code of the key that was pressed to exit
'
FUNCTION Menu (CurrChoiceX, MaxChoice, choice$(), ItemRow(), ItemCol(), menuHelp$(), BarMode)

    currChoice = CurrChoiceX

    'if in bar mode, color in menu bar, else color box/shadow
    'bar mode means you are currently in the menu bar, not a sub menu
    IF BarMode THEN
        COLOR colors(7, ColorPref), colors(4, ColorPref)
        LOCATE 1, 1
        PRINT SPACE$(80);
    ELSE
        FancyCls colors(2, ColorPref), colors(1, ColorPref)
        COLOR colors(7, ColorPref), colors(4, ColorPref)
        Box ItemRow(1) - 1, ItemCol(1) - 1, ItemRow(MaxChoice) + 1, ItemCol(1) + LEN(choice$(1)) + 1

        COLOR colors(10, ColorPref), colors(6, ColorPref)
        FOR a = 1 TO MaxChoice + 1
            LOCATE ItemRow(1) + a - 1, ItemCol(1) + LEN(choice$(1)) + 2
            PRINT CHR$(178); CHR$(178);
        NEXT a
        LOCATE ItemRow(MaxChoice) + 2, ItemCol(MaxChoice) + 2
        PRINT STRING$(LEN(choice$(MaxChoice)) + 2, 178);
    END IF

    'print the choices
    COLOR colors(7, ColorPref), colors(4, ColorPref)
    FOR a = 1 TO MaxChoice
        LOCATE ItemRow(a), ItemCol(a)
        PRINT choice$(a);
    NEXT a

    finished = FALSE

    WHILE NOT finished

        GOSUB MenuShowCursor
        GOSUB MenuGetKey
        GOSUB MenuHideCursor

        SELECT CASE Kbd$
            CASE CHR$(0) + "H": GOSUB MenuUp
            CASE CHR$(0) + "P": GOSUB MenuDown
            CASE CHR$(0) + "K": GOSUB MenuLeft
            CASE CHR$(0) + "M": GOSUB MenuRight
            CASE CHR$(13): GOSUB MenuEnter
            CASE CHR$(27): GOSUB MenuEscape
            CASE ELSE:  BEEP
        END SELECT
    WEND

    Menu = currChoice

    EXIT FUNCTION


MenuEnter:
    finished = TRUE
    RETURN

MenuEscape:
    currChoice = 0
    finished = TRUE
    RETURN

MenuUp:
    IF BarMode THEN
        BEEP
    ELSE
        currChoice = (currChoice + MaxChoice - 2) MOD MaxChoice + 1
    END IF
    RETURN

MenuLeft:
    IF BarMode THEN
        currChoice = (currChoice + MaxChoice - 2) MOD MaxChoice + 1
    ELSE
        currChoice = -2
        finished = TRUE
    END IF
    RETURN

MenuRight:
    IF BarMode THEN
        currChoice = (currChoice) MOD MaxChoice + 1
    ELSE
        currChoice = -3
        finished = TRUE
    END IF
    RETURN

MenuDown:
    IF BarMode THEN
        finished = TRUE
    ELSE
        currChoice = (currChoice) MOD MaxChoice + 1
    END IF
    RETURN

MenuShowCursor:
    COLOR colors(8, ColorPref), colors(9, ColorPref)
    LOCATE ItemRow(currChoice), ItemCol(currChoice)
    PRINT choice$(currChoice);
    PrintHelpLine menuHelp$(currChoice)
    RETURN

MenuGetKey:
    Kbd$ = ""
    WHILE Kbd$ = ""
        Kbd$ = INKEY$
    WEND
    RETURN

MenuHideCursor:
    COLOR colors(7, ColorPref), colors(4, ColorPref)
    LOCATE ItemRow(currChoice), ItemCol(currChoice)
    PRINT choice$(currChoice);
    RETURN


END FUNCTION

' B-LINK - BASIC Link to the NEWTON
' FREEWARE by John Marman (Compuserve: 70410,1257)
'
' This program may be freely distributed provided it is not altered and
' no fees may be charged for it's distribution.
'
'MenuSystem:
'  Main routine that controls the program.  Uses the MENU function
'  to implement menu system and calls the appropriate function to handle
'  the user's selection
SUB MenuSystem

    DIM choice$(20), menuRow(20), menuCol(20), menuHelp$(20)
    LOCATE , , 0
    choice = 1
    finished = FALSE

    ColorPref = 2

    WHILE NOT finished
        GOSUB MenuSystemMain

        subchoice = -1
        WHILE subchoice < 0
            SELECT CASE choice
                CASE 1: GOSUB MenuSystemFile
                CASE 2: GOSUB MenuSystemNewton
                CASE 3: GOSUB MenuSystemComm
            END SELECT
            FancyCls colors(2, ColorPref), colors(1, ColorPref)

            SELECT CASE subchoice
                CASE -2: choice = (choice + 4) MOD 3 + 1
                CASE -3: choice = (choice) MOD 3 + 1
            END SELECT
        WEND
    WEND
    EXIT SUB


MenuSystemMain:
    FancyCls colors(2, ColorPref), colors(1, ColorPref)
    COLOR colors(7, ColorPref), colors(4, ColorPref)
    Box 9, 19, 14, 61
    center 11, "Use arrow keys to navigate menu system"
    center 12, "Press Enter to select a menu item"

    choice$(1) = " File "
    choice$(2) = " Newton "
    choice$(3) = " Port   "

    menuRow(1) = 1: menuCol(1) = 2
    menuRow(2) = 1: menuCol(2) = 15
    menuRow(3) = 1: menuCol(3) = 28

    menuHelp$(1) = "Load/Save a database file or quit B-LINK"
    menuHelp$(2) = "Add data in NEWTON format"
    menuHelp$(3) = "Change the current COM port"

    DO
        NewChoice = Menu((choice), 3, choice$(), menuRow(), menuCol(), menuHelp$(), TRUE)
    LOOP WHILE NewChoice = 0
    choice = NewChoice
    RETURN

MenuSystemFile:

    choice$(1) = " Load   "
    choice$(2) = " Save   "
    choice$(3) = " Import "
    choice$(4) = " Summary"
    choice$(5) = " Exit   "

    menuRow(1) = 3: menuCol(1) = 2
    menuRow(2) = 4: menuCol(2) = 2
    menuRow(3) = 5: menuCol(3) = 2
    menuRow(4) = 6: menuCol(4) = 2
    menuRow(5) = 7: menuCol(5) = 2

    menuHelp$(1) = "Load existing B-LINK file"
    menuHelp$(2) = "Save current B-LINK file"
    menuHelp$(3) = "Import Data - to be developed!"
    menuHelp$(4) = "Summary of Data"
    menuHelp$(5) = "Exit the B-LINK"

    subchoice = Menu(1, 5, choice$(), menuRow(), menuCol(), menuHelp$(), FALSE)

    SELECT CASE subchoice
        CASE 1: CALL LoadRecords
        CASE 2: CALL SaveRecords
        CASE 4: CALL Summary
        CASE 5: finished = TRUE
        CASE ELSE
    END SELECT
    RETURN

MenuSystemNewton:

    choice$(1) = " Business Card "
    choice$(2) = " Appointment   "
    choice$(3) = " Notepad       "
    choice$(4) = " Anniversary   "
    choice$(5) = " Daily Note    "
    choice$(6) = " Daily Alarm   "

    menuRow(1) = 3: menuCol(1) = 15
    menuRow(2) = 4: menuCol(2) = 15
    menuRow(3) = 5: menuCol(3) = 15
    menuRow(4) = 6: menuCol(4) = 15
    menuRow(5) = 7: menuCol(5) = 15
    menuRow(6) = 8: menuCol(6) = 15

    menuHelp$(1) = "Add a business card"
    menuHelp$(2) = "Add a single appointment to the schedule"
    menuHelp$(3) = "Add a notepad item"
    menuHelp$(4) = "Create a recurring annual calendar note"
    menuHelp$(5) = "Create a recurring daily note"
    menuHelp$(6) = "Create a recurring daily alarm"

    subchoice = Menu(1, 6, choice$(), menuRow(), menuCol(), menuHelp$(), FALSE)

    SELECT CASE subchoice
        CASE 1 'business card
           SFScreenNum = NNAMES
           CALL DataEntry
        CASE 2 'appointment
           SFScreenNum = NSCHED
           CALL DataEntry
        CASE 3 'notepad
          SFScreenNum = NNOTE
          CALL DataEntry
        CASE 4 'anniversary
          SFScreenNum = NANN
          CALL DataEntry
        CASE 5 'daily note
          SFScreenNum = NDAILY
          CALL DataEntry
        CASE 6 'alarm
          SFScreenNum = NALARM
          CALL DataEntry
        CASE ELSE
    END SELECT
    RETURN

MenuSystemComm:

    choice$(1) = " COM1 "
    choice$(2) = " COM2 "

    menuRow(1) = 3: menuCol(1) = 28
    menuRow(2) = 4: menuCol(2) = 28

    menuHelp$(1) = "Set COMM port to COM1:"
    menuHelp$(2) = "Set COMM port to COM2:"

    subchoice = Menu(1, 2, choice$(), menuRow(), menuCol(), menuHelp$(), FALSE)

    SELECT CASE subchoice
        CASE 1 'com1
           COMM$ = "COM1:"
        CASE 2 'com2
           COMM$ = "COM2:"
        CASE ELSE
    END SELECT
    RETURN

END SUB

REM $STATIC
'
' Makes the next record the current record
'
SUB NextRecord

   i = 1
   WHILE CurrRecord + i <= NumRecords
        IF CRrecords(CurrRecord + i).CRType = SFScreenNum THEN GOTO foundnext
        i = i + 1
        WEND
   CALL ErrBeep
   EXIT SUB

foundnext:
   CurrRecord = CurrRecord + i
   CALL ShowRecord

END SUB

'
' Creates the main display and calls ShowRecord
'
SUB PaintDisplay

   COLOR scrnFg, scrnBg, scrnBg        'Clear screen
   CLS

   COLOR statFg, statBg                'Create title status bar
   LOCATE 1, 1: PRINT SPACE$(80)
   center 1, ScreenData(SFScreenNum).fname

   COLOR winFg, winBg                  'Create record window
   CALL Frame(WINTOP, WINBOTTOM, WINLEFT, WINRIGHT)

        i = ScreenData(SFScreenNum).fieldptr
        DO WHILE fields(i).SFScreen = SFScreenNum
                LOCATE fields(i).SFRow, fields(i).SFCol - (INSTR(fields(i).SFName, ":") + 1)
                PRINT fields(i).SFName
                i = i + 1
        LOOP


   LOCATE 25, 1                        'Display function-key bar
   COLOR scrnFg, scrnBg: PRINT "1";
   COLOR statFg, statBg: PRINT "Help  ";
   COLOR scrnFg, scrnBg: PRINT " 2";
   COLOR statFg, statBg: PRINT "Add   ";
   COLOR scrnFg, scrnBg: PRINT " 3";
   COLOR statFg, statBg: PRINT "Delete";
   COLOR scrnFg, scrnBg: PRINT " 4";
   COLOR statFg, statBg: PRINT "Edit  ";
   COLOR scrnFg, scrnBg: PRINT " 5";
   COLOR statFg, statBg: PRINT "Find  ";
   COLOR scrnFg, scrnBg: PRINT " 6";
   COLOR statFg, statBg: PRINT "Prev  ";
   COLOR scrnFg, scrnBg: PRINT " 7";
   COLOR statFg, statBg: PRINT "Next  ";
   COLOR scrnFg, scrnBg: PRINT " 8";
   COLOR statFg, statBg: PRINT "Send  ";
   COLOR scrnFg, scrnBg: PRINT " 9";
   COLOR statFg, statBg: PRINT "Print ";
   COLOR scrnFg, scrnBg: PRINT " 10";
   COLOR statFg, statBg: PRINT "Exit  ";

   CALL ShowRecord                     'Display current record

END SUB

'
' Makes the previous record the current record
'
SUB PrevRecord

   i = 1
   WHILE CurrRecord - i > 0
        IF CRrecords(CurrRecord - i).CRType = SFScreenNum THEN GOTO foundprev
        i = i + 1
        WEND
   CALL ErrBeep
   EXIT SUB

foundprev:
   CurrRecord = CurrRecord - i
   CALL ShowRecord

END SUB

REM $DYNAMIC
'PrintHelpLine:
'  Prints help text on the bottom row in the proper color
SUB PrintHelpLine (menuHelp$)
    COLOR colors(5, ColorPref), colors(4, ColorPref)
    LOCATE 25, 1
    PRINT SPACE$(80);
    center 25, menuHelp$
END SUB

REM $STATIC
'
' Send the database to the printer
'
SUB PrintRecords
   IF GetYesNo("Send records to printer [Y/N]?") THEN
      CALL ShowMessage("Printing records...")
      FOR j = 1 TO NumRecords
'       loop until end of this record type - move along pos pointer
        IF CRrecords(j).CRType < S THEN S = 1
        recpos = 1
        i = ScreenData(SFScreenNum).fieldptr
        LPRINT : LPRINT "------Record# "; j; " ------"
        DO WHILE fields(i).SFScreen = CRrecords(j).CRType
                fields(i).SFData = MID$(CRrecords(j).CRData, recpos, fields(i).SFMax)
                recpos = recpos + fields(i).SFMax
                LPRINT LEFT$(fields(i).SFName, INSTR(fields(i).SFName, ":") + 1); LEFT$(fields(i).SFData, fields(i).SFMax)
                i = i + 1
                LOOP
        LPRINT
      NEXT j
      CALL ClearMessage
   END IF

END SUB

'
' Writes the database to disk
'
SUB SaveRecords

   IF GetYesNo("Save records to disk [Y/N]?") THEN
      CALL ShowMessage("Saving records...")
      KILL "B-LINK.DAT"

      'Open the data file
      OPEN "B-LINK.DAT" FOR RANDOM AS #1 LEN = LEN(CRrecords(0))

      'Write the records to disk
      FOR i = 1 TO NumRecords
         PUT #1, i, CRrecords(i)
      NEXT i
      CLOSE #1

      CALL ClearMessage
   END IF

END SUB

REM $DYNAMIC
' B-LINK - BASIC Link to the NEWTON
' FREEWARE by John Marman (Compuserve: 70410,1257)
'
' This program may be freely distributed provided it is not altered and
' no fees may be charged for it's distribution.
'
SUB showdump (dinp$, dLEN)
FOR i = 1 TO dLEN
        char$ = MID$(dinp$, i, 1)
        IF char$ < " " THEN PRINT "<"; ASC(char$); ">";  ELSE PRINT char$;
        NEXT i
END SUB

REM $STATIC
'
' Displays the given message in the message area
'
SUB ShowMessage (message$)

   COLOR scrnFg, scrnBg
   LOCATE MESSAGEROW, (80 - LEN(message$)) / 2    'Center message string
   PRINT message$

END SUB

' B-LINK - BASIC Link to the NEWTON
' FREEWARE by John Marman (Compuserve: 70410,1257)
'
' This program may be freely distributed provided it is not altered and
' no fees may be charged for it's distribution.
'
'
' Displays the current record
'
SUB ShowRecord

   COLOR winFg, winBg

   'Show current record number against number of records
   LOCATE WINTOP, WINLEFT + 5
   PRINT "["; CurrRecord; "/"; NumRecords; "]"; STRING$(10, &HCD)

   IF NumRecords = 0 OR CRrecords(CurrRecord).CRType <> SFScreenNum THEN
      CALL ClearFields
   ELSE
        i = ScreenData(SFScreenNum).fieldptr
        recpos = 1
        DO WHILE fields(i).SFScreen = SFScreenNum
                fields(i).SFData = MID$(CRrecords(CurrRecord).CRData, recpos, fields(i).SFMax)
                recpos = recpos + fields(i).SFMax
                LOCATE fields(i).SFRow, fields(i).SFCol
                PRINT LEFT$(fields(i).SFData, fields(i).SFMax)
                i = i + 1
                LOOP
   END IF

END SUB

'
' Uses a shell sort to sort all the records in the database.
' Records are compared by calling CompareRecords.
'
SUB SortRecords

   IF NumRecords = 0 THEN        'Nothing to sort
      CALL ErrBeep
      EXIT SUB
   END IF

   IF GetYesNo("Sort records [Y/N]?") THEN

      'Set comparison offset to half the number of records
      offset = NumRecords \ 2

      DO WHILE offset > 0        'Loop until offset gets to 0
         limit = NumRecords - offset
         DO
            switch = 0           'Assume no switches at this offset

            'Compare elements and switch those out of order
            FOR i = 1 TO limit
               IF CompareRecords(i, i + offset) THEN
                  SWAP CRrecords(i), CRrecords(i + offset)
                  switch = i
               END IF
            NEXT i

            'Sort on next pass only to where last switch was made
            limit = switch - offset
         LOOP WHILE switch

         'No switches at last offset, try one half as big
         offset = offset \ 2

      LOOP
      CurrRecord = 1             'Go to first record and update screen
      CALL ShowRecord
   END IF

END SUB

REM $DYNAMIC
'  Creates a fancy border
SUB SparklePause

    COLOR 4, 0
    a$ = "*    *    *    *    *    *    *    *    *    *    *    *    *    *    *    *    *    "
    WHILE INKEY$ <> "": WEND 'empty type ahead
    WHILE INKEY$ = ""
        FOR a = 1 TO 5
            LOCATE 1, 1: PRINT MID$(a$, a, 80); : LOCATE 22, 1: PRINT MID$(a$, 6 - a, 80);
            FOR b = 2 TO 21
                c = (a + b) MOD 5
                IF c = 1 THEN
                    LOCATE b, 80: PRINT "*"; : LOCATE 23 - b, 1: PRINT "*";
                ELSE
                    LOCATE b, 80: PRINT " "; : LOCATE 23 - b, 1: PRINT " ";
                END IF
            NEXT b
        NEXT a
    WEND
END SUB

REM $STATIC
SUB Summary
DIM count(6)

        FOR i = 1 TO NumRecords
                j = CRrecords(i).CRType
                count(j) = count(j) + 1
                NEXT i

        Box 9, 19, 21, 61
        center 10, "** B-LINK V1.0 **"
        LOCATE 12, 22: PRINT " Business Card "; count(NNAMES)
        LOCATE 13, 22: PRINT " Appointment   "; count(NSCHED)
        LOCATE 14, 22: PRINT " Notepad       "; count(NNOTE)
        LOCATE 14, 45: PRINT " Port: "; COMM$
        LOCATE 15, 22: PRINT " Anniversary   "; count(NANN)
        LOCATE 16, 22: PRINT " Daily Note    "; count(NDAILY)
        LOCATE 17, 22: PRINT " Daily Alarm   "; count(NALARM)
        LOCATE 18, 22: PRINT " TOTAL........."; NumRecords
        LOCATE 20, 30: PRINT "(c) 1994 John Marman"
        SLEEP 0
END SUB

REM $DYNAMIC
'Trim$:
'  Remove null and spaces from the end of a string.
FUNCTION Trim$ (x$)

    IF x$ = "" THEN
        Trim$ = ""
    ELSE
        lastChar = 0
        FOR a = 1 TO LEN(x$)
            y$ = MID$(x$, a, 1)
            IF y$ <> CHR$(0) AND y$ <> " " THEN
                lastChar = a
            END IF
        NEXT a
        Trim$ = LEFT$(x$, lastChar)
    END IF

END FUNCTION

REM $STATIC
' B-LINK - BASIC Link to the NEWTON
' FREEWARE by John Marman (Compuserve: 70410,1257)
'
' This program may be freely distributed provided it is not altered and
' no fees may be charged for it's distribution.
'
FUNCTION XmitNewton%
DIM outdata$(7)

        IF GetYesNo("Press 'Y' if you have saved your data!") = 0 THEN EXIT FUNCTION
        IF GetYesNo("Press 'Y' if you have selected '" + SharpRec(CRrecords(CurrRecord).CRType).Sname + "' from the SHARP icon") = 0 THEN EXIT FUNCTION

        CALL ShowMessage("Opening port: " + COMM$ + " and preparing data...")

'       open the serial port with options to allow it to talk to the NEWTON
        OPEN COMM$ + "9600,N,8,1,cd0,cs0,ds0,rs,bin" FOR RANDOM AS #2

        APPNAME$ = SharpRec(CRrecords(CurrRecord).CRType).Sapp
        APPNUM$ = SharpRec(CRrecords(CurrRecord).CRType).Snum

'       extract data from CurrRecord
        i = ScreenData(SFScreenNum).fieldptr
        recpos = 1
        DO WHILE fields(i).SFScreen = SFScreenNum
                temp$ = MID$(CRrecords(CurrRecord).CRData, recpos, fields(i).SFMax)
                k = INSTR(temp$, CHR$(0))
                IF k > 0 THEN temp$ = LEFT$(temp$, k - 1) ELSE temp$ = LEFT$(temp$, fields(i).SFMax)
                ' embed a newline at the end of each note line
                IF SFScreenNum = NNOTE AND fields(i).SFPos < 5 AND LEN(temp$) > 0 THEN temp$ = temp$ + HT$
                FOR j = 1 TO fields(i).SFSuff
                        temp$ = temp$ + CRLF$
                        NEXT j
                outdata$(fields(i).SFPos) = temp$
                recpos = recpos + fields(i).SFMax
                i = i + 1
                LOOP

'       rearrange the data into the proper order for the NEWT
        appdata$ = ""
        FOR i = 1 TO SharpRec(CRrecords(CurrRecord).CRType).Sfields
                appdata$ = appdata$ + outdata$(i)
                NEXT i

'       calculate the correct checksum
        outbuf$ = APPNUM$ + "00" + CRLF$ + APPNAME$ + CRLF$ + "00" + appdata$ + CRLF$ + SUB$
        chksum = checksum(appdata$) + SharpRec(CRrecords(CurrRecord).CRType).Schksum
        chksum$ = ComposeChkSum(chksum)

        IF GetYesNo("Press 'Y' then press 'RECEIVE' on your NEWTON") = 0 THEN EXIT FUNCTION
        CALL ShowMessage("Transmitting...")

'       look for the NEWT

                            '*** NOTE:
        INP$ = INPUT$(2, 2) '*** IF YOU GET STUCK HERE IT'S PROBABLY
                            '*** BECAUSE YOU HAVE NOT SELECTED THE
                            '*** CORRECT COM PORT! (THE PORT'S NOT
                            '*** RESPONDING)

        IF INP$ <> ETX$ + "D" THEN GOTO errx

'       tell the NEWT that we're a SHARP 8200
         PRINT #2, "8200" + CRLF$ + "0000" + HT$ + "0000" + HT$ + "01000000" + HT$ + CRLF$ + SUB$ + "4D03" + CRLF$ + SUB$;

'       look for confirmation, and see what app is selected on the NEWT

        INP$ = INPUT$(44, 2) ' *** IF YOU GET STUCK HERE IT'S PROBABLY
                             ' *** BECAUSE THE COM PORT HAS SCREWED UP!
                             ' *** TRY RESTARTING THE DOS SESSION AND RE-TRY

        IF RIGHT$(INP$, 13) <> APPNAME$ + CRLF$ THEN GOTO errx

'       ok... send the data
        PRINT #2, ETX$ + "0000" + HT$ + "0000" + HT$ + "01000000" + HT$ + CRLF$;
        PRINT #2, outbuf$;
        PRINT #2, chksum$ + CRLF$ + SUB$;

'       success!
        CLOSE #2
        XmitNewton = 0
        CALL ClearMessage
        IF GetYesNo("Success! Delete the current record (Y/N)") <> 0 THEN CALL DeleteRecord
        EXIT FUNCTION

errx:
        CLOSE #2
        CLS
        PRINT "Error transmitting information!"
        PRINT "Port="; COMM$; "  Appname="; APPNAME$
        PRINT : PRINT "Outbuf :";
        CALL showdump(outbuf$, LEN(outbuf$))
        PRINT : PRINT : PRINT "Inbuf :";
        CALL showdump(INP$, LEN(INP$))
        PRINT : PRINT : PRINT
        PRINT "The COMM may be screwed up... select QUIT and try again!"
        PRINT
        IF GetYesNo("Press 'Y' to continue, 'N' to QUIT") = 0 THEN SYSTEM
        XmitNewton = -1

END FUNCTION